home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / tls / tls088.hpux.Z / tls088.hpux / lib / vtcl / tests / cberror.tcl < prev    next >
Encoding:
Text File  |  1995-07-20  |  1.4 KB  |  64 lines
  1. # CVS $Id: cberror.tcl,v 1.3 1995/02/03 16:54:20 zibi Exp $
  2. #
  3. # This tests the error callback routines
  4. # 
  5.  
  6.  
  7. #
  8. # This handles the error without generating another error.
  9. proc errorCB {cbs} {
  10.     set target [keylget cbs widget]
  11.     set dialog [keylget cbs dialog]
  12.     set result [keylget cbs result]
  13.     set callback [keylget cbs callback]
  14.  
  15.     set str "Handling callback for <$target>"
  16.     set str "$str \n  result is <$result>"
  17.     set str "$str \n  callback is <$callback>"
  18.  
  19.     set txt [VtGetValues $dialog -userData]    
  20.     VtSetValues $txt -value $str
  21. }
  22.  
  23. #
  24. # This handles an error, but generates an error of it's own
  25. #
  26. proc errorErrorCB {cbs} {
  27.      echo "I'm dying...."
  28.  
  29.      # This generates an error
  30.      continue
  31. }
  32.  
  33. proc generateErrorCB {errStr cbs} {
  34.      # This generates an error
  35.      error $errStr
  36.  
  37.      echo "here"
  38. }
  39.  
  40. global txt
  41.  
  42. set app [VtOpen error]
  43.  
  44. set dlog [VtFormDialog $app.form -errorCallback errorCB \
  45.       -okCallback "generateErrorCB {OK buton} " \
  46.       -wmCloseCallback "generateErrorCB wmCloseCallback" ]
  47.  
  48. set errTxt [VtText $dlog.txt -rightSide FORM -rows 5 -columns 40 \
  49.         -wordWrap ]
  50.  
  51.  
  52. VtSetValues $dlog -userData $errTxt
  53.  
  54. set txt $errTxt
  55.  
  56. VtPushButton $dlog.but1 -label "Handle Error" -callback "generateErrorCB Handle"
  57.  
  58. VtPushButton $dlog.but2 -label "Error with Error" \
  59.          -errorCallback errorErrorCB  -callback "generateErrorCB bad"
  60.  
  61. VtShow $dlog
  62.  
  63. VtMainLoop
  64.